home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / Evi_Collec2092881252007.psc / Evi Collection Control XP UPDATE v1.1 / Controls / EviButton.ctl
Text File  |  2007-12-05  |  67KB  |  1,760 lines
  1. VERSION 5.00
  2. Begin VB.UserControl EviButton 
  3.    ClientHeight    =   1470
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   2910
  7.    LockControls    =   -1  'True
  8.    PropertyPages   =   "EviButton.ctx":0000
  9.    ScaleHeight     =   1470
  10.    ScaleWidth      =   2910
  11.    ToolboxBitmap   =   "EviButton.ctx":003E
  12.    Begin VB.Timer OverTimer 
  13.       Enabled         =   0   'False
  14.       Interval        =   10
  15.       Left            =   0
  16.       Top             =   0
  17.    End
  18.    Begin VB.Image imgHAND 
  19.       Height          =   480
  20.       Left            =   720
  21.       Top             =   0
  22.       Visible         =   0   'False
  23.       Width           =   480
  24.    End
  25. End
  26. Attribute VB_Name = "EviButton"
  27. Attribute VB_GlobalNameSpace = False
  28. Attribute VB_Creatable = True
  29. Attribute VB_PredeclaredId = False
  30. Attribute VB_Exposed = True
  31. Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
  32. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  33. '                       Evi Collection Control XP                      '
  34. '                          By Evi Indra Effendi                        '
  35. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  36. Option Explicit
  37.  
  38. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  39. Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
  40. Private Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long
  41. Private Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hdc As Long, ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, lpDrawTextParams As textparametreleri) As Long
  42. Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  43. Private Declare Function InitCommonControlsEx Lib "comctl32.dll" (ByRef iccInit As ICCEX) As Long
  44. Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  45. Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cX As Long, ByVal cY As Long, ByVal wFlags As Long) As Long
  46. Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
  47. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  48. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  49. Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  50. Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  51. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  52. Private Declare Function SetPixel Lib "gdi32" Alias "SetPixelV" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
  53. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  54. Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  55. Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
  56. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  57. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  58. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  59. Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
  60. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  61. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  62. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  63. Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
  64. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  65. Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
  66. Private Declare Function ShellExecute _
  67.    Lib "shell32.dll" Alias "ShellExecuteA" _
  68.    (ByVal hWnd As Long, _
  69.     ByVal lpOperation As String, _
  70.     ByVal lpFile As String, _
  71.     ByVal lpParameters As String, _
  72.     ByVal lpDirectory As String, _
  73.     ByVal nShowCmd As Long) As Long
  74. Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  75. Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
  76. Private Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
  77. Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
  78.  
  79. Private Origin As Long
  80. Private m_Stat As Long
  81. Private m_Tats As Long
  82.  
  83. Private Type RECT
  84.     Left      As Long
  85.     Top       As Long
  86.     Right     As Long
  87.     Bottom    As Long
  88. End Type
  89.  
  90. Private Type ControlType
  91.     cntrlObjectForm As Object
  92.     cntrlHwnd As Long
  93.     cntrlToolTipsText As String
  94.     cntrlToolTipsTitle As String
  95.     cntrlToolTipsIcon As Integer
  96. End Type
  97.  
  98. Dim m_ControlType() As ControlType
  99.  
  100. Private Type TOOLINFO
  101.     cbSize As Long
  102.     dwFlags As Long
  103.     hWnd As Long
  104.     dwID As Long
  105.     rtRect As RECT
  106.     hInst As Long
  107.     lpszText As Long
  108.     lParam  As Long
  109. End Type
  110.  
  111. Private Type textparametreleri
  112.     cbSize As Long
  113.     iTabLength As Long
  114.     iLeftMargin As Long
  115.     iRightMargin As Long
  116.     uiLengthDrawn As Long
  117. End Type
  118.  
  119. Private Type POINTAPI
  120.     X As Long
  121.     Y As Long
  122. End Type
  123.  
  124. Private Type RGB
  125.     Red As Double
  126.     Green As Double
  127.     Blue As Double
  128. End Type
  129. Private Type ICCEX
  130.     dwSize As Long
  131.     dwICC As Long
  132. End Type
  133. 'enum picture position
  134. Public Enum EviPicturePosition
  135.     eviTopJustify = 0
  136.     eviLeftJustify = 1
  137.     eviRightJustify = 2
  138.     eviBottomJustify = 3
  139. End Enum
  140. 'enum evi button style
  141. Public Enum EviButtonStyle
  142.     eviStandardButton = 0
  143.     eviFlatButton = 1
  144.     eviOfficeXPButton = 2
  145.     eviWindoXPButton = 3
  146.     eviNoBorderButton = 4
  147. End Enum
  148. 'enum icon size
  149. Public Enum IconSizeEnum
  150.     [16 x 16] = 0
  151.     [32 x 32] = 1
  152.     [Default] = 2
  153.     [Custom] = 3
  154. End Enum
  155. 'client rect
  156. Private mvarClientRect As RECT
  157. 'picture rect
  158. Private mvarPictureRect As RECT
  159. 'caption rect
  160. Private mvarCaptionRect As RECT
  161. Dim mvarOrgRect As RECT
  162. Dim g_FocusRect As RECT
  163. Dim alan As RECT
  164. Dim m_OriginalPicSizeW  As Long
  165. Dim m_OriginalPicSizeH  As Long
  166. Dim m_PictureOriginal As Picture
  167. Dim m_PictureHover As Picture
  168. Dim m_Caption As String
  169. Dim m_PicturePosition As EviPicturePosition
  170. Dim m_ButtonStyle As EviButtonStyle
  171. Dim m_Picture As Picture
  172. Dim m_PictureWidth As Long
  173. Dim m_PictureHeight As Long
  174. Dim m_PictureSize As IconSizeEnum
  175. Dim mvarDrawTextParams As textparametreleri
  176. Dim g_HasFocus As Byte
  177. Dim g_MouseDown As Byte, g_MouseIn As Byte
  178. Dim g_Button As Integer, g_Shift As Integer, g_X As Single, g_Y As Single
  179. Dim g_KeyPressed As Byte
  180. Dim m_ShowFocusRect As Boolean
  181. Dim WithEvents g_Font As StdFont
  182. Attribute g_Font.VB_VarHelpID = -1
  183. Const mvarPadding As Byte = 4
  184. Dim m_BEVEL As Integer
  185. Dim m_BEVELDEPTH As Integer
  186. Dim m_TransparentBG As Boolean
  187. Dim m_MaskColor As OLE_COLOR
  188. Dim m_XPShowBorderAlways As Boolean
  189. Dim m_DefCurHand As Boolean
  190. Dim m_ForeColor As OLE_COLOR
  191. Dim m_BackColor As OLE_COLOR
  192. Dim m_XPDefaultColors As Boolean
  193. Dim m_XPColor_Pressed As OLE_COLOR
  194. Dim m_XPColor_Hover As OLE_COLOR
  195. 'for tool tip
  196. Private m_Object As Object
  197. Dim m_ToolTipText As String
  198. Dim m_ToolTipTitle As String
  199. Dim m_ToolTipIcon As ttIconType
  200. Dim m_Counter As Long
  201. Private ghWndTip As Long, ghWndParent As Long
  202.  
  203. Enum ttIconType
  204.   [No Icon] = 0
  205.   [Icon Info] = 1
  206.   [Icon Warning] = 2
  207.   [Icon Error] = 3
  208. End Enum
  209.  
  210. Private Const HWND_TOPMOST As Long = -1
  211. Private Const SWP_NOMOVE As Long = &H2
  212. Private Const SWP_NOSIZE As Long = &H1
  213.  
  214. Private Const ICC_WIN95_CLASSES As Long = &HFF
  215.  
  216. Private Const CCM_FIRST As Long = &H2000
  217. Private Const CCM_SETWINDOWTHEME As Long = (CCM_FIRST + &HB)
  218. Private Const WM_USER As Long = &H400
  219. Private Const CW_USEDEFAULT As Long = &H80000000
  220. Private Const ECM_FIRST As Long = &H1500
  221.  
  222. Private Const EM_SHOWBALLOONTIP = ECM_FIRST + 3
  223.  
  224. Private Const WS_POPUP As Long = &H80000000
  225. Private Const WS_EX_TOPMOST As Long = &H8&
  226.  
  227. Private Const TOOLTIPS_CLASSA As String = "tooltips_class32"
  228.  
  229. Private Const TTF_ABSOLUTE As Long = &H80
  230. Private Const TTF_CENTERTIP As Long = &H2
  231. Private Const TTF_DI_SETITEM As Long = &H8000
  232. Private Const TTF_IDISHWND As Long = &H1
  233. Private Const TTF_RTLREADING As Long = &H4
  234. Private Const TTF_SUBCLASS As Long = &H10
  235. Private Const TTF_TRACK As Long = &H20
  236. Private Const TTF_TRANSPARENT As Long = &H100
  237.  
  238. Private Const TTI_ERROR As Long = 3
  239. Private Const TTI_INFO As Long = 1
  240. Private Const TTI_NONE As Long = 0
  241. Private Const TTI_WARNING As Long = 2
  242.  
  243. Private Const TTM_ACTIVATE As Long = (WM_USER + 1)
  244. Private Const TTM_ADDTOOL As Long = (WM_USER + 4)
  245. Private Const TTM_ADJUSTRECT As Long = (WM_USER + 31)
  246. Private Const TTM_DELTOOL As Long = (WM_USER + 5)
  247. Private Const TTM_ENUMTOOLS As Long = (WM_USER + 14)
  248. Private Const TTM_GETBUBBLESIZE As Long = (WM_USER + 30)
  249. Private Const TTM_GETCURRENTTOOL As Long = (WM_USER + 15)
  250. Private Const TTM_GETDELAYTIME As Long = (WM_USER + 21)
  251. Private Const TTM_GETMARGIN As Long = (WM_USER + 27)
  252. Private Const TTM_GETMAXTIPWIDTH As Long = (WM_USER + 25)
  253. Private Const TTM_GETTEXT As Long = (WM_USER + 11)
  254. Private Const TTM_GETTIPBKCOLOR As Long = (WM_USER + 22)
  255. Private Const TTM_GETTIPTEXTCOLOR As Long = (WM_USER + 23)
  256. Private Const TTM_GETTOOLCOUNT As Long = (WM_USER + 13)
  257. Private Const TTM_GETTOOLINFO As Long = (WM_USER + 8)
  258. Private Const TTM_HITTEST As Long = (WM_USER + 10)
  259. Private Const TTM_NEWTOOLRECT As Long = (WM_USER + 6)
  260. Private Const TTM_POP As Long = (WM_USER + 28)
  261. Private Const TTM_POPUP As Long = (WM_USER + 34)
  262. Private Const TTM_RELAYEVENT As Long = (WM_USER + 7)
  263. Private Const TTM_SETDELAYTIME As Long = (WM_USER + 3)
  264. Private Const TTM_SETMARGIN As Long = (WM_USER + 26)
  265. Private Const TTM_SETMAXTIPWIDTH As Long = (WM_USER + 24)
  266. Private Const TTM_SETTIPBKCOLOR As Long = (WM_USER + 19)
  267. Private Const TTM_SETTIPTEXTCOLOR As Long = (WM_USER + 20)
  268. Private Const TTM_SETTITLE As Long = (WM_USER + 32)
  269. Private Const TTM_SETTOOLINFO As Long = (WM_USER + 9)
  270. Private Const TTM_SETWINDOWTHEME As Long = CCM_SETWINDOWTHEME
  271. Private Const TTM_TRACKACTIVATE As Long = (WM_USER + 17)
  272. Private Const TTM_TRACKPOSITION As Long = (WM_USER + 18)
  273. Private Const TTM_UPDATE As Long = (WM_USER + 29)
  274. Private Const TTM_UPDATETIPTEXT As Long = (WM_USER + 12)
  275. Private Const TTM_WINDOWFROMPOINT As Long = (WM_USER + 16)
  276.  
  277. Private Const TTN_FIRST As Long = (-520)
  278. Private Const TTN_GETDISPINFO As Long = (TTN_FIRST - 0)
  279. Private Const TTN_LAST As Long = (-549)
  280. Private Const TTN_LINKCLICK As Long = (TTN_FIRST - 3)
  281. Private Const TTN_NEEDTEXT As Long = TTN_GETDISPINFO
  282. Private Const TTN_POP As Long = (TTN_FIRST - 2)
  283. Private Const TTN_SHOW As Long = (TTN_FIRST - 1)
  284.  
  285. Private Const TTS_ALWAYSTIP As Long = &H1
  286. Private Const TTS_BALLOON As Long = &H40
  287. Private Const TTS_NOANIMATE As Long = &H10
  288. Private Const TTS_NOFADE As Long = &H20
  289. Private Const TTS_NOPREFIX As Long = &H2
  290.  
  291. 'declare event
  292. Event Click()
  293. Event KeyDown(KeyCode As Integer, Shift As Integer)
  294. Event KeyPress(KeyAscii As Integer)
  295. Event KeyUp(KeyCode As Integer, Shift As Integer)
  296. Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  297. Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  298. Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  299. Event MouseIn(Shift As Integer)
  300. Event MouseOut(Shift As Integer)
  301.  
  302. Private Sub UserControl_InitProperties()
  303. On Error GoTo Error
  304.     m_BackColor = &H8000000F
  305.     m_ForeColor = &H80000012
  306.     m_ShowFocusRect = 1
  307.     Set UserControl.Font = Ambient.Font
  308.     Set g_Font = Ambient.Font
  309.     m_Caption = Ambient.DisplayName
  310.     m_PicturePosition = 1
  311.     m_ButtonStyle = 2
  312.     m_PictureWidth = 32
  313.     m_PictureHeight = 32
  314.     m_PictureSize = 1
  315.     Set m_PictureHover = LoadPicture("")
  316.     Set m_PictureOriginal = LoadPicture("")
  317.     m_XPColor_Pressed = &H80000014
  318.     m_XPColor_Hover = &H80000016
  319.     m_XPDefaultColors = 1
  320.     
  321.     m_DefCurHand = 0
  322.     m_XPShowBorderAlways = 0
  323.     m_MaskColor = 0
  324.     m_TransparentBG = 0
  325.     m_BEVEL = 1
  326.     m_BEVELDEPTH = 8
  327.     Set m_Object = UserControl.Parent
  328. Error:
  329. End Sub
  330.  
  331. Private Sub UserControl_Paint()
  332. On Error GoTo Error
  333. Set m_Object = UserControl.Parent
  334. Error:
  335. End Sub
  336.  
  337. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  338. On Error GoTo Error
  339.     Set m_Object = UserControl.Parent
  340.     m_BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
  341.     UserControl.BackColor = m_BackColor
  342.     m_ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
  343.     UserControl.ForeColor = m_ForeColor
  344.     m_ToolTipText = PropBag.ReadProperty("ToolTipText", UserControl.Extender.ToolTipText)
  345.     m_ToolTipTitle = PropBag.ReadProperty("ToolTipTitle", "")
  346.     m_ToolTipIcon = PropBag.ReadProperty("ToolTipIcon", 0)
  347.     UserControl.Extender.ToolTipText = PropBag.ReadProperty("ToolTipText", m_ToolTipText)
  348.     m_ShowFocusRect = PropBag.ReadProperty("Focus", 1)
  349.     m_Caption = PropBag.ReadProperty("Caption", Ambient.DisplayName)
  350.     m_PicturePosition = PropBag.ReadProperty("IconPosition", 1)
  351.     m_ButtonStyle = PropBag.ReadProperty("ButtonStyle", 2)
  352.     Set m_Picture = PropBag.ReadProperty("Icon", Nothing)
  353.     m_PictureWidth = PropBag.ReadProperty("IconWidth", 32)
  354.     m_PictureHeight = PropBag.ReadProperty("IconHeight", 32)
  355.     m_PictureSize = PropBag.ReadProperty("IconSize", 1)
  356.     m_OriginalPicSizeW = PropBag.ReadProperty("OriginalPicSizeW", 32)
  357.     m_OriginalPicSizeH = PropBag.ReadProperty("OriginalPicSizeH", 32)
  358.     Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
  359.     Set g_Font = PropBag.ReadProperty("Font", Ambient.Font)
  360.     Set m_PictureHover = PropBag.ReadProperty("IconHover", Nothing)
  361.     Set m_PictureOriginal = PropBag.ReadProperty("Picture", Nothing)
  362.     Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
  363.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  364.     UserControl.MousePointer = PropBag.ReadProperty("MousePointer", 0)
  365.  
  366.     m_XPColor_Pressed = PropBag.ReadProperty("ColorPressed", &H80000014)
  367.     m_XPColor_Hover = PropBag.ReadProperty("ColorHover", &H80000016)
  368.     m_XPDefaultColors = PropBag.ReadProperty("DefaultColors", 1)
  369.     
  370.     m_DefCurHand = PropBag.ReadProperty("DefCurHand", 0)
  371.     m_XPShowBorderAlways = PropBag.ReadProperty("ShowBorder", 0)
  372.     m_MaskColor = PropBag.ReadProperty("MaskColor", 0)
  373.     m_TransparentBG = PropBag.ReadProperty("Transparent", 0)
  374.     m_BEVEL = PropBag.ReadProperty("BEVEL", 1)
  375.     m_BEVELDEPTH = PropBag.ReadProperty("BEVELDEPTH", 8)
  376.     SetAccessKeys
  377.     
  378.     UserControl_Resize
  379. Error:
  380. End Sub
  381.  
  382. Private Sub UserControl_Show()
  383. On Error GoTo Error
  384. Set m_Object = UserControl.Parent
  385. SHowTool
  386. Error:
  387. End Sub
  388.  
  389. Private Sub UserControl_Terminate()
  390. On Error GoTo Error
  391.     DeleteObject Origin
  392.     Set g_Font = Nothing
  393. Error:
  394. End Sub
  395.  
  396. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  397.     Call PropBag.WriteProperty("Caption", m_Caption, Ambient.DisplayName)
  398.     Call PropBag.WriteProperty("IconPosition", m_PicturePosition, 1)
  399.     Call PropBag.WriteProperty("ButtonStyle", m_ButtonStyle, 2)
  400.     Call PropBag.WriteProperty("Icon", m_Picture, Nothing)
  401.     Call PropBag.WriteProperty("IconWidth", m_PictureWidth, 32)
  402.     Call PropBag.WriteProperty("IconHeight", m_PictureHeight, 32)
  403.     Call PropBag.WriteProperty("IconSize", m_PictureSize, 1)
  404.     Call PropBag.WriteProperty("OriginalPicSizeW", m_OriginalPicSizeW, 32)
  405.     Call PropBag.WriteProperty("OriginalPicSizeH", m_OriginalPicSizeH, 32)
  406.     Call PropBag.WriteProperty("ToolTipText", m_ToolTipText, UserControl.Extender.ToolTipText)
  407.     Call PropBag.WriteProperty("ToolTipTitle", m_ToolTipTitle, "")
  408.     Call PropBag.WriteProperty("ToolTipIcon", m_ToolTipIcon, 0)
  409.     Call PropBag.WriteProperty("IconHover", m_PictureHover, Nothing)
  410.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  411.     Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
  412.     Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
  413.     Call PropBag.WriteProperty("MousePointer", UserControl.MousePointer, 0)
  414.     Call PropBag.WriteProperty("Focus", m_ShowFocusRect, 1)
  415.     Call PropBag.WriteProperty("ColorPressed", m_XPColor_Pressed, &H80000014)
  416.     Call PropBag.WriteProperty("ColorHover", m_XPColor_Hover, &H80000016)
  417.     Call PropBag.WriteProperty("DefaultColors", m_XPDefaultColors, 1)
  418.     Call PropBag.WriteProperty("BackColor", m_BackColor, &H8000000F)
  419.     Call PropBag.WriteProperty("ForeColor", m_ForeColor, &H80000012)
  420.     Call PropBag.WriteProperty("DefCurHand", m_DefCurHand, 0)
  421.     Call PropBag.WriteProperty("ShowBorder", m_XPShowBorderAlways, 0)
  422.     Call PropBag.WriteProperty("MaskColor", m_MaskColor, 0)
  423.     Call PropBag.WriteProperty("Transparent", m_TransparentBG, 0)
  424.     Call PropBag.WriteProperty("BEVEL", m_BEVEL, 1)
  425.     Call PropBag.WriteProperty("BEVELDEPTH", m_BEVELDEPTH, 8)
  426.  End Sub
  427. Private Sub CalcRECTs()
  428. On Error GoTo Error
  429.     Dim picWidth, picHeight, capWidth, capHeight As Long
  430.     With alan
  431.         .Left = 0
  432.         .Top = 0
  433.         .Right = ScaleWidth - 1
  434.         .Bottom = ScaleHeight - 1
  435.     End With
  436.     
  437.     With mvarClientRect
  438.      .Left = alan.Left + mvarPadding
  439.      .Top = alan.Top + mvarPadding
  440.      .Right = alan.Right - mvarPadding + 1
  441.      .Bottom = alan.Bottom - mvarPadding + 1
  442.     End With
  443.     
  444.     If m_Picture Is Nothing Then
  445.         With mvarCaptionRect
  446.            .Left = mvarClientRect.Left
  447.            .Top = mvarClientRect.Top
  448.            .Right = mvarClientRect.Right
  449.            .Bottom = mvarClientRect.Bottom
  450.         End With
  451.         CalculateCaptionRect
  452.     Else
  453.         If m_Caption = "" Then
  454.          With mvarPictureRect
  455.             .Left = (((mvarClientRect.Right - mvarClientRect.Left) - m_PictureWidth) \ 2) + mvarClientRect.Left
  456.             .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - m_PictureHeight) \ 2) + mvarClientRect.Top
  457.             .Right = mvarPictureRect.Left + m_PictureWidth
  458.             .Bottom = mvarPictureRect.Top + m_PictureHeight
  459.          End With
  460.             Exit Sub
  461.         End If
  462.         
  463.         With mvarCaptionRect
  464.         .Left = mvarClientRect.Left
  465.         .Top = mvarClientRect.Top
  466.         .Right = mvarClientRect.Right
  467.         .Bottom = mvarClientRect.Bottom
  468.         End With
  469.         CalculateCaptionRect
  470.         
  471.         picWidth = m_PictureWidth
  472.         picHeight = m_PictureHeight
  473.         capWidth = mvarCaptionRect.Right - mvarCaptionRect.Left
  474.         capHeight = mvarCaptionRect.Bottom - mvarCaptionRect.Top
  475.         
  476.         
  477.         If m_PicturePosition = 1 Then
  478.             With mvarPictureRect
  479.                 .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - picHeight) \ 2) + mvarClientRect.Top
  480.                 .Left = (((mvarClientRect.Right - mvarClientRect.Left) - (picWidth + mvarPadding + capWidth)) \ 2) + mvarClientRect.Left
  481.                 .Bottom = mvarPictureRect.Top + picHeight
  482.                 .Right = mvarPictureRect.Left + picWidth
  483.             End With
  484.             With mvarCaptionRect
  485.                 .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - capHeight) \ 2) + mvarClientRect.Top
  486.                 .Left = mvarPictureRect.Right + mvarPadding
  487.                 .Bottom = mvarCaptionRect.Top + capHeight
  488.                 .Right = mvarCaptionRect.Left + capWidth
  489.             End With
  490.         
  491.         ElseIf m_PicturePosition = 2 Then
  492.             With mvarCaptionRect
  493.                 .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - capHeight) \ 2) + mvarClientRect.Top
  494.                 .Left = (((mvarClientRect.Right - mvarClientRect.Left) - (picWidth + mvarPadding + capWidth)) \ 2) + mvarClientRect.Left
  495.                 .Bottom = mvarCaptionRect.Top + capHeight
  496.                 .Right = mvarCaptionRect.Left + capWidth
  497.             End With
  498.             With mvarPictureRect
  499.                 .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - picHeight) \ 2) + mvarClientRect.Top
  500.                 .Left = mvarCaptionRect.Right + mvarPadding
  501.                 .Bottom = mvarPictureRect.Top + picHeight
  502.                 .Right = mvarPictureRect.Left + picWidth
  503.             End With
  504.         ElseIf m_PicturePosition = 0 Then
  505.             With mvarPictureRect
  506.                 .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - (picHeight + mvarPadding + capHeight)) \ 2) + mvarClientRect.Top
  507.                 .Left = (((mvarClientRect.Right - mvarClientRect.Left) - picWidth) \ 2) + mvarClientRect.Left
  508.                 .Bottom = mvarPictureRect.Top + picHeight
  509.                 .Right = mvarPictureRect.Left + picWidth
  510.             End With
  511.             With mvarCaptionRect
  512.                 .Top = mvarPictureRect.Bottom + mvarPadding
  513.                 .Left = (((mvarClientRect.Right - mvarClientRect.Left) - capWidth) \ 2) + mvarClientRect.Left
  514.                 .Bottom = mvarCaptionRect.Top + capHeight
  515.                 .Right = mvarCaptionRect.Left + capWidth
  516.             End With
  517.         ElseIf m_PicturePosition = 3 Then
  518.             With mvarCaptionRect
  519.                 .Top = (((mvarClientRect.Bottom - mvarClientRect.Top) - (picHeight + mvarPadding + capHeight)) \ 2) + mvarClientRect.Top
  520.                 .Left = (((mvarClientRect.Right - mvarClientRect.Left) - capWidth) \ 2) + mvarClientRect.Left
  521.                 .Bottom = mvarCaptionRect.Top + capHeight
  522.                 .Right = mvarCaptionRect.Left + capWidth
  523.             End With
  524.             With mvarPictureRect
  525.                 .Top = mvarCaptionRect.Bottom + mvarPadding
  526.                 .Left = (((mvarClientRect.Right - mvarClientRect.Left) - picWidth) \ 2) + mvarClientRect.Left
  527.                 .Bottom = mvarPictureRect.Top + picHeight
  528.                 .Right = mvarPictureRect.Left + picWidth
  529.             End With
  530.         End If
  531.     End If
  532.     
  533. Error:
  534. End Sub
  535.  
  536. Private Sub UserControl_Initialize()
  537. On Error GoTo Error
  538.     Set g_Font = New StdFont
  539.     
  540.     ScaleMode = 3
  541.     PaletteMode = 3
  542. Error:
  543. End Sub
  544.  
  545. Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
  546.     If Not Me.Enabled Then Exit Sub
  547.         RaiseEvent Click
  548. End Sub
  549.  
  550. Private Sub UserControl_AmbientChanged(PropertyName As String)
  551.     Refresh
  552. End Sub
  553.  
  554. Private Sub UserControl_EnterFocus()
  555.     g_HasFocus = 1
  556.     Refresh
  557. End Sub
  558.  
  559. Private Sub UserControl_ExitFocus()
  560.     g_HasFocus = 0
  561.     g_MouseDown = 0
  562.     Refresh
  563. End Sub
  564.  
  565. Private Sub UserControl_Resize()
  566. On Error GoTo Error
  567.     If ScaleWidth < 10 Then UserControl.Width = 150
  568.     If ScaleHeight < 10 Then UserControl.Height = 150
  569.     
  570.     m_Stat = ScaleWidth
  571.     m_Tats = ScaleHeight
  572.  
  573.     g_FocusRect.Left = 4
  574.     g_FocusRect.Right = ScaleWidth - 4
  575.     g_FocusRect.Top = 4
  576.     g_FocusRect.Bottom = ScaleHeight - 4
  577.     
  578.     DeleteObject Origin
  579.     If m_ButtonStyle = eviWindoXPButton Then
  580.         RoundCorners
  581.     End If
  582.     Refresh
  583. Error:
  584. End Sub
  585. Public Sub Refresh()
  586. On Error GoTo Error
  587.     AutoRedraw = True
  588.                       
  589.     UserControl.Cls
  590.     
  591.     XPAdjustColorScheme
  592.     If m_ButtonStyle <> 4 Then Draw3DEffect
  593.     CalcRECTs
  594.     DrawPicture
  595.     If g_HasFocus = 1 And m_ShowFocusRect And m_ButtonStyle <> 3 Then DrawFocusRect hdc, g_FocusRect
  596.     DrawCaption
  597.     AutoRedraw = False
  598. Error:
  599. End Sub
  600.  
  601. Private Sub SHowTool()
  602. On Error GoTo Error
  603.     Set m_Object = UserControl.Parent
  604.     m_ToolTipText = UserControl.Extender.ToolTipText
  605.     UserControl.Extender.ToolTipText = ""
  606.     AddToolTipText m_Object, hWnd, m_ToolTipText, m_ToolTipTitle, m_ToolTipIcon
  607.     ShowToolTipText
  608. Error:
  609. End Sub
  610.  
  611. Public Property Get ToolTipText() As String
  612. ToolTipText = m_ToolTipText
  613. End Property
  614.  
  615. Public Property Let ToolTipText(ByVal New_Text As String)
  616. m_ToolTipText = New_Text
  617. PropertyChanged "ToolTipText"
  618. End Property
  619.  
  620. Public Property Get ToolTipTitle() As String
  621. ToolTipTitle = m_ToolTipTitle
  622. End Property
  623.  
  624. Public Property Let ToolTipTitle(ByVal New_Title As String)
  625. m_ToolTipTitle = New_Title
  626. PropertyChanged "ToolTipTitle"
  627. End Property
  628.  
  629. Public Property Get ToolTipIcon() As ttIconType
  630. ToolTipIcon = m_ToolTipIcon
  631. End Property
  632.  
  633. Public Property Let ToolTipIcon(ByVal New_Icon As ttIconType)
  634. m_ToolTipIcon = New_Icon
  635. PropertyChanged "ToolTipIcon"
  636. End Property
  637.  
  638. Private Sub UserControl_DblClick()
  639.     SetCapture hWnd
  640.     UserControl_MouseDown g_Button, g_Shift, g_X, g_Y
  641. End Sub
  642.  
  643. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  644.     If g_KeyPressed = 0 Then
  645.                              
  646.                              
  647.             If KeyCode = 32 Then
  648.                 g_MouseDown = 1
  649.                 g_MouseIn = 1
  650.                 Refresh
  651.             End If
  652.         g_KeyPressed = 1
  653.     End If
  654.     RaiseEvent KeyDown(KeyCode, Shift)
  655. End Sub
  656.  
  657. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  658.     RaiseEvent KeyPress(KeyAscii)
  659. End Sub
  660.  
  661. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  662.     If KeyCode = 32 Then
  663.         g_MouseDown = 0
  664.         g_MouseIn = 0
  665.         Refresh
  666.  
  667.         UserControl_MouseUp 1, Shift, 0, 0
  668.     End If
  669.     g_KeyPressed = 0
  670.     RaiseEvent KeyUp(KeyCode, Shift)
  671. End Sub
  672.  
  673. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  674.     g_Button = Button: g_Shift = Shift: g_X = X: g_Y = Y
  675.     If Button <> 2 Then
  676.         g_MouseDown = 1
  677.         Refresh
  678.     End If
  679.     RaiseEvent MouseDown(Button, Shift, X, Y)
  680. End Sub
  681.  
  682. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  683.     If (X >= 0 And Y >= 0) And (X < ScaleWidth And Y < ScaleHeight) Then
  684.         If g_MouseIn = 0 Then
  685.             OverTimer.Enabled = True
  686.             g_MouseIn = 1
  687.             If Not m_PictureHover Is Nothing Then
  688.                 Set m_Picture = m_PictureHover
  689.             End If
  690.             RaiseEvent MouseIn(Shift)
  691.             Refresh
  692.             DoEvents
  693.             
  694.         End If
  695.     End If
  696.     RaiseEvent MouseMove(Button, Shift, X, Y)
  697. End Sub
  698. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  699.     g_MouseDown = 0
  700.     If Button <> 2 Then
  701.         Refresh
  702.         If (X >= 0 And Y >= 0) And (X < ScaleWidth And Y < ScaleHeight) Then
  703.             RaiseEvent Click
  704.         End If
  705.     End If
  706.     RaiseEvent MouseUp(Button, Shift, X, Y)
  707. End Sub
  708.  
  709. Public Property Get Enabled() As Boolean
  710.     Enabled = UserControl.Enabled
  711. End Property
  712.  
  713. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  714.     UserControl.Enabled() = New_Enabled
  715.     PropertyChanged "Enabled"
  716.     Refresh
  717. End Property
  718. Public Property Get Font() As Font
  719.     Set Font = g_Font
  720. End Property
  721.  
  722. Public Property Set Font(ByVal New_Font As Font)
  723.     With g_Font
  724.         .Name = New_Font.Name
  725.         .Size = New_Font.Size
  726.         .Bold = New_Font.Bold
  727.         .Italic = New_Font.Italic
  728.         .Underline = New_Font.Underline
  729.         .Strikethrough = New_Font.Strikethrough
  730.     End With
  731.     PropertyChanged "Font"
  732. End Property
  733.  
  734. Private Sub g_Font_FontChanged(ByVal PropertyName As String)
  735.     Set UserControl.Font = g_Font
  736.     Refresh
  737. End Sub
  738.  
  739. Public Property Get hWnd() As Long
  740.     hWnd = UserControl.hWnd
  741. End Property
  742.  
  743. Public Property Get MousePointer() As MousePointerConstants
  744.     MousePointer = UserControl.MousePointer
  745. End Property
  746.  
  747. Public Property Let MousePointer(ByVal New_MousePointer As MousePointerConstants)
  748.     UserControl.MousePointer() = New_MousePointer
  749.     PropertyChanged "MousePointer"
  750. End Property
  751.  
  752. Public Property Get MouseIcon() As StdPicture
  753.     Set MouseIcon = UserControl.MouseIcon
  754. End Property
  755.  
  756. Public Property Set MouseIcon(ByVal New_MouseIcon As StdPicture)
  757.     Set UserControl.MouseIcon = New_MouseIcon
  758.     PropertyChanged "MouseIcon"
  759. End Property
  760.  
  761. Public Property Get Focus() As Boolean
  762.     Focus = m_ShowFocusRect
  763. End Property
  764.  
  765. Public Property Let Focus(ByVal New_ShowFocusRect As Boolean)
  766.     m_ShowFocusRect = New_ShowFocusRect
  767.     PropertyChanged "Focus"
  768.     Refresh
  769. End Property
  770.              
  771. Private Sub RunXTRA3D(RENK As Long, BEVELL As Integer, BEVELDEPTHH As Integer)
  772. On Error GoTo Error
  773.     Dim T As Integer
  774.     Dim TEMPRENK As Long
  775.                 TEMPRENK = RENK
  776.                 BEVELDEPTHH = BEVELDEPTHH * (-1)
  777.                 
  778.                 For T = BEVELL To 0 Step -1
  779.                     TEMPRENK = COLOR_DarkenLightenColor(TEMPRENK, BEVELDEPTHH)
  780.                     DRAWRECT hdc, T, T, ScaleWidth - T, ScaleHeight - T, TEMPRENK, 0
  781.                 Next T
  782.              
  783.                 BEVELDEPTHH = BEVELDEPTHH * (-1)
  784.                 For T = BEVELL To 0 Step -1
  785.                     RENK = RGB(COLOR_LongToRGB(RENK).Red + BEVELDEPTHH, COLOR_LongToRGB(RENK).Green + BEVELDEPTHH, COLOR_LongToRGB(RENK).Blue + BEVELDEPTHH)
  786.                     DrawLine T, T, ScaleWidth - (T + 1), T, RENK
  787.                     DrawLine T, T, T, ScaleHeight - (T + 1), RENK
  788.                     
  789.                 Next T
  790. Error:
  791. End Sub
  792. Private Sub RunXTRA3D_PRESSED(RENK As Long, BEVELL As Integer, BEVELDEPTHH As Integer)
  793.     Dim Ret As Integer
  794.     Dim GRIN As Integer
  795.     Dim BLU As Integer
  796.     Dim T As Integer
  797.     On Error GoTo Error
  798.                 Dim TEMPRENK As Long
  799.                 TEMPRENK = RENK
  800.                 
  801.                 For T = BEVELL To 0 Step -1
  802.                     Ret = COLOR_LongToRGB(TEMPRENK).Red + BEVELDEPTHH
  803.                     GRIN = COLOR_LongToRGB(TEMPRENK).Green + BEVELDEPTHH
  804.                     BLU = COLOR_LongToRGB(TEMPRENK).Blue + BEVELDEPTHH
  805.                     TEMPRENK = RGB(Ret, GRIN, BLU)
  806.                     DRAWRECT hdc, T, T, ScaleWidth - T, ScaleHeight - T, TEMPRENK, 0
  807.                 Next T
  808.                 
  809.                 
  810.                 BEVELDEPTHH = BEVELDEPTHH * (-1)
  811.                 For T = BEVELL To 0 Step -1
  812.                     RENK = COLOR_DarkenLightenColor(RENK, BEVELDEPTHH)
  813.                     DrawLine T, T, ScaleWidth - (T + 1), T, RENK
  814.                     DrawLine T, T, T, ScaleHeight - (T + 1), RENK
  815.                 Next T
  816. Error:
  817. End Sub
  818. Private Sub RunShowBorderOnFocus(RENK As Long, BEVELL As Integer, BEVELDEPTHH As Integer)
  819. Dim T As Integer
  820. On Error GoTo Error
  821.             If BEVELL < 2 Then
  822.                 DRAWRECT hdc, 0, 0, ScaleWidth - 1, ScaleHeight - 1, &H80000010
  823.                 DRAWRECT hdc, 0, 0, ScaleWidth + 1, ScaleHeight + 1, &H80000014
  824.                 DRAWRECT hdc, -1, -1, ScaleWidth + 1, ScaleHeight + 1, &H80000015
  825.             Else
  826.                 RunXTRA3D COLOR_UniColor(UserControl.BackColor), m_BEVEL, BEVELDEPTH + 3
  827.             End If
  828. Error:
  829. End Sub
  830. Private Sub XPAdjustColorScheme()
  831. On Error GoTo Error
  832. If m_ButtonStyle = eviWindoXPButton Then Exit Sub
  833.     If m_ButtonStyle = eviOfficeXPButton Then
  834.         If m_TransparentBG = True And g_MouseDown = 0 Then
  835.             Transparentia
  836.         Else
  837.             UserControl.BackColor = m_BackColor
  838.         End If
  839.     Else
  840.         If m_TransparentBG = True Then Transparentia
  841.     End If
  842.  
  843.     If m_ButtonStyle = eviOfficeXPButton Then
  844.         Dim l1 As Double
  845.         Dim l2 As Double
  846.         Dim l3 As Double
  847.         Dim ll As Double
  848.         Dim KOLOR As RGB
  849.         l1 = 171
  850.         l2 = 154
  851.         l3 = 108
  852.         ll = -15
  853.         KOLOR = COLOR_LongToRGB(COLOR_UniColor(&H8000000D))
  854.         If g_MouseDown = 0 And g_MouseIn = 1 Then
  855.                 If DefaultColors = True Then
  856.                    
  857.                    UserControl.BackColor = RGB(KOLOR.Red + l1, KOLOR.Green + l2, _
  858.                                                                     KOLOR.Blue + l3)
  859.                 Else
  860.                    UserControl.BackColor = ColorHover
  861.                 End If
  862.         End If
  863.         
  864.         If g_MouseDown = 1 Then
  865.                 If DefaultColors = True Then
  866.                     UserControl.BackColor = RGB(KOLOR.Red + l1 + ll, _
  867.                                     KOLOR.Green + l2 + ll, KOLOR.Blue + l3)
  868.                 Else
  869.                     UserControl.BackColor = ColorPressed
  870.                 End If
  871.         End If
  872.     End If
  873. Error:
  874. End Sub
  875. Private Sub Draw3DEffect()
  876. On Error GoTo Error
  877.     If Not Ambient.UserMode Then
  878.         If m_ButtonStyle = eviWindoXPButton Then
  879.                 DrawWinXPButton 0
  880.         ElseIf m_ButtonStyle = eviOfficeXPButton Then
  881.                 XPAdjustColorScheme
  882.         Else
  883.             If m_BEVEL < 2 Then
  884.                 DRAWRECT hdc, 0, 0, ScaleWidth, ScaleHeight, &H80000010
  885.                 DRAWRECT hdc, 0, 0, ScaleWidth + 1, ScaleHeight + 1, &H80000014
  886.             Else
  887.                 RunXTRA3D COLOR_UniColor(UserControl.BackColor), m_BEVEL, BEVELDEPTH
  888.             End If
  889.         End If
  890.     Exit Sub
  891.     End If
  892.     
  893.     If m_ButtonStyle = eviOfficeXPButton Then
  894.                 If Not (ShowBorder = False And g_MouseIn = 0) Then
  895.                     DRAWRECT hdc, 0, 0, ScaleWidth, ScaleHeight, m_ForeColor
  896.                 End If
  897.     ElseIf m_ButtonStyle = eviWindoXPButton Then
  898.             If g_MouseDown = 1 Then DrawWinXPButton 2
  899.             If g_MouseDown = 0 And g_MouseIn = 1 Then DrawWinXPButton 0, 1
  900.             If g_MouseDown = 0 And g_MouseIn = 0 Then DrawWinXPButton 0
  901.     Else
  902.         If g_MouseDown = 1 Then
  903.             If m_BEVEL < 2 Then
  904.                 DRAWRECT hdc, 0, 0, ScaleWidth, ScaleHeight, &H80000014
  905.                 DRAWRECT hdc, 0, 0, ScaleWidth + 1, ScaleHeight + 1, &H80000010
  906.             Else
  907.                 RunXTRA3D_PRESSED COLOR_UniColor(UserControl.BackColor), m_BEVEL, BEVELDEPTH
  908.             End If
  909.         End If
  910.         If g_MouseDown = 0 And g_MouseIn = 1 Then
  911.             If m_BEVEL < 2 Then
  912.                 DRAWRECT hdc, 0, 0, ScaleWidth, ScaleHeight, &H80000010
  913.                 DRAWRECT hdc, 0, 0, ScaleWidth + 1, ScaleHeight + 1, &H80000014
  914.             Else
  915.                 RunXTRA3D COLOR_UniColor(UserControl.BackColor), m_BEVEL, BEVELDEPTH
  916.             End If
  917.         End If
  918.         
  919.         If g_MouseDown = 0 And g_MouseIn = 0 And m_ButtonStyle = 0 Then
  920.             If m_BEVEL < 2 Then
  921.                 DRAWRECT hdc, 0, 0, ScaleWidth, ScaleHeight, &H80000010
  922.                 DRAWRECT hdc, 0, 0, ScaleWidth + 1, ScaleHeight + 1, &H80000014
  923.             Else
  924.                 RunXTRA3D COLOR_UniColor(UserControl.BackColor), m_BEVEL, BEVELDEPTH
  925.             End If
  926.         End If
  927.          
  928.           If (g_HasFocus = 1 And m_ButtonStyle = 0 And g_MouseDown = 0) Or Extender.Default Then
  929.                     RunShowBorderOnFocus COLOR_UniColor(UserControl.BackColor), m_BEVEL, BEVELDEPTH
  930.          End If
  931.     End If
  932. Error:
  933. End Sub
  934. Private Sub OverTimer_Timer()
  935. On Error GoTo Error
  936.     Dim P As POINTAPI
  937.     GetCursorPos P
  938.     If hWnd <> WindowFromPoint(P.X, P.Y) Then
  939.         OverTimer.Enabled = False
  940.         g_MouseIn = 0
  941.         RaiseEvent MouseOut(g_Shift)
  942.         Refresh
  943.         If g_MouseDown = 1 Then
  944.             g_MouseDown = 0
  945.             Refresh
  946.             g_MouseDown = 1
  947.         End If
  948.     End If
  949. Error:
  950. End Sub
  951.  
  952. Public Property Get Caption() As String
  953.     Caption = m_Caption
  954. End Property
  955. Public Property Let Caption(ByVal New_Caption As String)
  956.     m_Caption = New_Caption
  957.     PropertyChanged "Caption"
  958.     SetAccessKeys
  959.     Refresh
  960. End Property
  961. Public Property Get ButtonStyle() As EviButtonStyle
  962.     ButtonStyle = m_ButtonStyle
  963. End Property
  964. Public Property Let ButtonStyle(ByVal New_ButtonStyle As EviButtonStyle)
  965.     m_ButtonStyle = New_ButtonStyle
  966.     PropertyChanged "ButtonStyle"
  967.     If m_ButtonStyle = eviWindoXPButton Then Transparent = False
  968.     UserControl_Resize
  969. End Property
  970.  
  971. Public Property Get IconPosition() As EviPicturePosition
  972.     IconPosition = m_PicturePosition
  973. End Property
  974. Public Property Let IconPosition(ByVal New_PicturePosition As EviPicturePosition)
  975.     m_PicturePosition = New_PicturePosition
  976.     PropertyChanged "IconPosition"
  977.     Refresh
  978. End Property
  979. Public Property Get Icon() As Picture
  980.     Set Icon = m_Picture
  981. End Property
  982. Public Property Set Icon(ByVal New_Picture As Picture)
  983.     Set m_Picture = New_Picture
  984.     Set m_PictureOriginal = New_Picture
  985.     If m_Picture Is Nothing Then
  986.         m_OriginalPicSizeW = 32
  987.         m_OriginalPicSizeH = 32
  988.     Else
  989.         m_OriginalPicSizeW = UserControl.ScaleX(m_Picture.Width, 8, UserControl.ScaleMode)
  990.         m_OriginalPicSizeH = UserControl.ScaleY(m_Picture.Height, 8, UserControl.ScaleMode)
  991.     End If
  992.     PropertyChanged "Icon"
  993.     If m_PictureSize = 2 Then
  994.         m_PictureWidth = UserControl.ScaleX(m_Picture.Width, 8, UserControl.ScaleMode)
  995.         m_PictureHeight = UserControl.ScaleY(m_Picture.Height, 8, UserControl.ScaleMode)
  996.     End If
  997.     Refresh
  998. End Property
  999.  
  1000. Public Property Get IconWidth() As Long
  1001.     IconWidth = m_PictureWidth
  1002. End Property
  1003. Public Property Let IconWidth(ByVal New_PictureWidth As Long)
  1004.     m_PictureWidth = New_PictureWidth
  1005.     PropertyChanged "IconWidth"
  1006.     Refresh
  1007. End Property
  1008. Public Property Get IconHeight() As Long
  1009.     IconHeight = m_PictureHeight
  1010. End Property
  1011. Public Property Let IconHeight(ByVal New_PictureHeight As Long)
  1012.     m_PictureHeight = New_PictureHeight
  1013.     PropertyChanged "IconHeight"
  1014.     Refresh
  1015. End Property
  1016. Public Property Get IconSize() As IconSizeEnum
  1017.     IconSize = m_PictureSize
  1018. End Property
  1019. Public Property Let IconSize(ByVal New_PictureSize As IconSizeEnum)
  1020.     m_PictureSize = New_PictureSize
  1021.     PropertyChanged "IconSize"
  1022.     
  1023.     If New_PictureSize = 0 Then
  1024.         m_PictureWidth = 16
  1025.         m_PictureHeight = 16
  1026.     ElseIf New_PictureSize = 1 Then
  1027.         m_PictureWidth = 32
  1028.         m_PictureHeight = 32
  1029.     ElseIf New_PictureSize = 2 Then
  1030.         If Not (m_Picture Is Nothing) Then
  1031.             m_PictureWidth = m_OriginalPicSizeW
  1032.             m_PictureHeight = m_OriginalPicSizeH
  1033.         Else
  1034.             m_PictureWidth = 32
  1035.             m_PictureHeight = 32
  1036.         End If
  1037.     End If
  1038.    
  1039.     Refresh
  1040. End Property
  1041.  
  1042. Private Sub CalculateCaptionRect()
  1043. On Error GoTo Error
  1044.     Dim mvarWidth, mvarHeight As Long
  1045.     Dim mvarFormat As Long
  1046.     With mvarDrawTextParams
  1047.         .iLeftMargin = 1
  1048.         .iRightMargin = 1
  1049.         .iTabLength = 1
  1050.         .cbSize = Len(mvarDrawTextParams)
  1051.     End With
  1052.     mvarFormat = &H400 Or &H10 Or &H4 Or &H1
  1053.     DrawTextEx hdc, m_Caption, Len(m_Caption), mvarCaptionRect, mvarFormat, mvarDrawTextParams
  1054.     mvarWidth = mvarCaptionRect.Right - mvarCaptionRect.Left
  1055.     mvarHeight = mvarCaptionRect.Bottom - mvarCaptionRect.Top
  1056.     With mvarCaptionRect
  1057.         .Left = mvarClientRect.Left + (((mvarClientRect.Right - mvarClientRect.Left) - (mvarCaptionRect.Right - mvarCaptionRect.Left)) \ 2)
  1058.         .Top = mvarClientRect.Top + (((mvarClientRect.Bottom - mvarClientRect.Top) - (mvarCaptionRect.Bottom - mvarCaptionRect.Top)) \ 2)
  1059.         .Right = mvarCaptionRect.Left + mvarWidth
  1060.         .Bottom = mvarCaptionRect.Top + mvarHeight
  1061.     End With
  1062. Error:
  1063. End Sub
  1064.  
  1065. Private Sub DrawCaption()
  1066. On Error GoTo Error
  1067.     If m_Caption = "" Then Exit Sub
  1068.     
  1069.     SetTextColor hdc, COLOR_UniColor(m_ForeColor)
  1070.     
  1071.     Dim mvarForeColor As OLE_COLOR
  1072.     mvarOrgRect = mvarCaptionRect
  1073.     If g_MouseDown = 1 And m_ButtonStyle <> 2 Then
  1074.        With mvarCaptionRect
  1075.         .Left = mvarCaptionRect.Left + 1
  1076.         .Top = mvarCaptionRect.Top + 1
  1077.         .Right = mvarCaptionRect.Right + 1
  1078.         .Bottom = mvarCaptionRect.Bottom + 1
  1079.        End With
  1080.     End If
  1081.     
  1082.     If Not Enabled Then
  1083.         Dim g_tmpFontColor As OLE_COLOR
  1084.         g_tmpFontColor = UserControl.ForeColor
  1085.         
  1086.         SetTextColor hdc, COLOR_UniColor(&H80000014)
  1087.         Dim mvarCaptionRect_Iki As RECT
  1088.         With mvarCaptionRect_Iki
  1089.             .Bottom = mvarCaptionRect.Bottom
  1090.             .Left = mvarCaptionRect.Left + 1
  1091.             .Right = mvarCaptionRect.Right + 1
  1092.             .Top = mvarCaptionRect.Top + 1
  1093.         End With
  1094.         DrawTextEx hdc, m_Caption, Len(m_Caption), mvarCaptionRect_Iki, &H10 Or &H4 Or &H1, mvarDrawTextParams
  1095.         
  1096.         SetTextColor hdc, COLOR_UniColor(&H80000010)
  1097.         DrawTextEx hdc, m_Caption, Len(m_Caption), mvarCaptionRect, &H10 Or &H4 Or &H1, mvarDrawTextParams
  1098.         
  1099.         SetTextColor hdc, COLOR_UniColor(g_tmpFontColor)
  1100.         Exit Sub
  1101.     End If
  1102.     DrawTextEx hdc, m_Caption, Len(m_Caption), mvarCaptionRect, &H10 Or &H4 Or &H1, mvarDrawTextParams
  1103.     mvarCaptionRect = mvarOrgRect
  1104. Error:
  1105. End Sub
  1106. Private Sub DrawBitmap(EnabledPic As Byte, CurPictRECT As RECT, _
  1107.                             Optional AsShadow As Byte = 0)
  1108. Dim DC1 As Long
  1109. Dim BM1 As Long
  1110. Dim DC2 As Long
  1111. Dim BM2 As Long
  1112. Dim UZUN1 As Long
  1113. Dim UZUN2 As Long
  1114. Dim hBrush As Long
  1115. On Error GoTo Error
  1116. DC1 = CreateCompatibleDC(hdc)
  1117. DC2 = CreateCompatibleDC(hdc)
  1118. BM1 = CreateCompatibleBitmap(hdc, m_OriginalPicSizeW, m_OriginalPicSizeH)
  1119. BM2 = CreateCompatibleBitmap(hdc, m_PictureWidth, m_PictureHeight)
  1120. UZUN1 = SelectObject(DC1, BM1)
  1121. UZUN2 = SelectObject(DC2, BM2)
  1122.  
  1123. If EnabledPic = 0 Then
  1124.                 Dim DC3 As Long
  1125.                 Dim BM3 As Long
  1126.                 
  1127.                 DC3 = CreateCompatibleDC(hdc)
  1128.                 BM3 = SelectObject(DC3, m_Picture.Handle)
  1129.                 
  1130.                 SetBkColor DC1, &HFFFFFF
  1131.                  
  1132.                 DRAWRECT DC1, 0, 0, _
  1133.                     m_OriginalPicSizeW, m_OriginalPicSizeH, &HFFFFFF, 1
  1134.  
  1135.                 TransParentPic DC1, DC1, DC3, 0, 0, _
  1136.                     m_OriginalPicSizeW, m_OriginalPicSizeH, 0, 0, m_MaskColor
  1137.                 
  1138.                 StretchBlt DC2, 0, 0, _
  1139.                     m_PictureWidth, _
  1140.                         m_PictureHeight, _
  1141.                             DC1, 0, 0, m_OriginalPicSizeW, m_OriginalPicSizeH, &HCC0020
  1142.                 
  1143.                 SelectObject DC2, UZUN2
  1144.                 
  1145.                 If AsShadow = 1 Then
  1146.                     hBrush = CreateSolidBrush(RGB(146, 146, 146))
  1147.                     Call DrawState(hdc, hBrush, 0, BM2, 0, CurPictRECT.Left, _
  1148.                                  CurPictRECT.Top, 0, 0, &H80& Or &H4&)
  1149.                     DeleteObject hBrush
  1150.                 Else
  1151.                     Call DrawState(hdc, 0, 0, BM2, 0, CurPictRECT.Left, _
  1152.                                  CurPictRECT.Top, 0, 0, &H20& Or &H4&)
  1153.                 End If
  1154.  
  1155.     DeleteObject BM3
  1156.     DeleteDC DC3
  1157.                 
  1158. Else
  1159.                 Call DrawState(DC1, 0, 0, m_Picture, 0, 0, 0, 0, 0, _
  1160.                     &H0 Or &H4&)
  1161.             
  1162.                 StretchBlt DC2, 0, 0, _
  1163.                     m_PictureWidth, _
  1164.                         m_PictureHeight, _
  1165.                             DC1, 0, 0, m_OriginalPicSizeW, m_OriginalPicSizeH, &HCC0020
  1166.                             
  1167.                 TransParentPic hdc, hdc, DC2, 0, 0, _
  1168.                     m_PictureWidth, m_PictureHeight, _
  1169.                      CurPictRECT.Left, CurPictRECT.Top, m_MaskColor
  1170.                 
  1171. End If
  1172.     SelectObject DC1, UZUN1
  1173.     SelectObject DC2, UZUN2
  1174.     DeleteObject BM1
  1175.     DeleteObject BM2
  1176.     DeleteDC DC1
  1177.     DeleteDC DC2
  1178. Error:
  1179. End Sub
  1180. Private Sub DrawPIcon(EnabledPic As Byte, CurPictRECT As RECT, Optional AsShadow As Byte = 0)
  1181. On Error GoTo Error
  1182. If EnabledPic = 0 Then
  1183.                  Dim DC1 As Long
  1184.                 Dim BM1 As Long
  1185.                 Dim DC2 As Long
  1186.                 Dim BM2 As Long
  1187.                 Dim UZUN1 As Long
  1188.                 Dim UZUN2 As Long
  1189.                 Dim hBrush As Long
  1190.                     
  1191.                 DC1 = CreateCompatibleDC(hdc)
  1192.                 BM1 = CreateCompatibleBitmap(hdc, m_OriginalPicSizeW, m_OriginalPicSizeH)
  1193.             
  1194.                 DC2 = CreateCompatibleDC(hdc)
  1195.                 BM2 = CreateCompatibleBitmap(hdc, m_PictureWidth, m_PictureHeight)
  1196.             
  1197.                 UZUN1 = SelectObject(DC1, BM1)
  1198.                 UZUN2 = SelectObject(DC2, BM2)
  1199.                 
  1200.                 If AsShadow = 1 Then
  1201.                     hBrush = CreateSolidBrush(RGB(146, 146, 146))
  1202.                     Call DrawState(DC1, hBrush, 0, m_Picture, 0, 0, 0, 0, 0, _
  1203.                         &H80& Or &H3&)
  1204.                     DeleteObject hBrush
  1205.                 Else
  1206.                     Call DrawState(DC1, 0, 0, m_Picture, 0, 0, 0, 0, 0, _
  1207.                        &H20& Or &H3&)
  1208.                 End If
  1209.                 
  1210.                 StretchBlt DC2, 0, 0, _
  1211.                     CurPictRECT.Right - CurPictRECT.Left, _
  1212.                         CurPictRECT.Bottom - CurPictRECT.Top, _
  1213.                             DC1, 0, 0, m_OriginalPicSizeW, m_OriginalPicSizeH, &HCC0020
  1214.                             
  1215.                 TransParentPic hdc, hdc, DC2, 0, 0, _
  1216.                     m_PictureWidth, m_PictureHeight, _
  1217.                       CurPictRECT.Left, CurPictRECT.Top, &H0
  1218.                 
  1219.                 SelectObject DC1, UZUN1
  1220.                 SelectObject DC2, UZUN2
  1221.                 DeleteObject BM1
  1222.                 DeleteObject BM2
  1223.                 DeleteDC DC1
  1224.                 DeleteDC DC2
  1225.  
  1226. Else
  1227.             UserControl.PaintPicture m_Picture, CurPictRECT.Left, _
  1228.                 CurPictRECT.Top, CurPictRECT.Right - CurPictRECT.Left, _
  1229.                   CurPictRECT.Bottom - CurPictRECT.Top, 0, 0, _
  1230.                     m_OriginalPicSizeW, m_OriginalPicSizeH
  1231. End If
  1232. Error:
  1233. End Sub
  1234.  
  1235. Private Sub DrawPicture()
  1236. On Error GoTo Error
  1237.     Dim Margin As Integer
  1238.     
  1239.     If m_Picture Is Nothing Then Exit Sub
  1240.     mvarOrgRect = mvarPictureRect
  1241.     
  1242.     If g_MouseDown = 0 And g_MouseIn = 1 And m_ButtonStyle = eviOfficeXPButton Then
  1243.       
  1244.         Margin = -3
  1245.     ElseIf g_MouseDown = 1 And Not m_ButtonStyle = eviOfficeXPButton Then
  1246.       
  1247.         Margin = 1
  1248.     End If
  1249.     
  1250.     With mvarPictureRect
  1251.         .Left = .Left + Margin
  1252.         .Top = .Top + Margin
  1253.         .Right = .Right + Margin
  1254.         .Bottom = .Bottom + Margin
  1255.     End With
  1256.  
  1257.         If m_Picture.Type = 1 Then
  1258.             If Not Enabled Then
  1259.                 DrawBitmap 0, mvarPictureRect
  1260.             Else
  1261.                 If g_MouseDown = 0 And g_MouseIn = 1 And _
  1262.                             m_ButtonStyle = eviOfficeXPButton Then _
  1263.                     DrawBitmap 0, mvarOrgRect, 1
  1264.                 
  1265.                 DrawBitmap 1, mvarPictureRect
  1266.             End If
  1267.         ElseIf m_Picture.Type = 3 Then
  1268.             If Not Enabled Then
  1269.                 DrawPIcon 0, mvarPictureRect
  1270.             Else
  1271.                 If g_MouseDown = 0 And g_MouseIn = 1 And _
  1272.                         m_ButtonStyle = eviOfficeXPButton Then _
  1273.                     DrawPIcon 0, mvarOrgRect, 1
  1274.                     
  1275.                 DrawPIcon 1, mvarPictureRect
  1276.             End If
  1277.         End If
  1278. mvarPictureRect = mvarOrgRect
  1279. Error:
  1280. End Sub
  1281. Private Sub Transparentia()
  1282.   On Error Resume Next
  1283. Dim RESIM As StdPicture
  1284. Dim mem_dc As Long
  1285. Dim mem_bm As Long
  1286. Dim orig_bm As Long
  1287. Dim wid As Long
  1288. Dim hgt As Long
  1289. Dim IX As Long
  1290. Dim YE As Long
  1291.  
  1292. IX = ScaleX(Extender.Left, Parent.ScaleMode, ScaleMode)
  1293. YE = ScaleY(Extender.Top, Parent.ScaleMode, ScaleMode)
  1294.  
  1295. Set RESIM = Parent.Picture
  1296.     mem_dc = CreateCompatibleDC(hdc)
  1297.     mem_bm = CreateCompatibleBitmap(mem_dc, ScaleWidth, ScaleHeight)
  1298.     
  1299.     SelectObject mem_dc, RESIM.Handle
  1300.     
  1301.     BitBlt hdc, 0, 0, ScaleWidth, ScaleHeight, _
  1302.         mem_dc, IX, YE, &HCC0020
  1303.     
  1304.     SelectObject mem_dc, orig_bm
  1305.     DeleteObject mem_bm
  1306.     DeleteDC mem_dc
  1307.     Set RESIM = Nothing
  1308. End Sub
  1309.  
  1310. Public Property Get IconHover() As Picture
  1311.     Set IconHover = m_PictureHover
  1312. End Property
  1313.  
  1314. Public Property Set IconHover(ByVal New_PictureHover As Picture)
  1315.     Set m_PictureHover = New_PictureHover
  1316.     PropertyChanged "IconHover"
  1317. End Property
  1318. Public Property Get ColorPressed() As OLE_COLOR
  1319.     ColorPressed = m_XPColor_Pressed
  1320. End Property
  1321.  
  1322. Public Property Let ColorPressed(ByVal New_XPColor_Pressed As OLE_COLOR)
  1323.     m_XPColor_Pressed = New_XPColor_Pressed
  1324.     PropertyChanged "ColorPressed"
  1325. End Property
  1326. Public Property Get ColorHover() As OLE_COLOR
  1327.     ColorHover = m_XPColor_Hover
  1328. End Property
  1329.  
  1330. Public Property Let ColorHover(ByVal New_XPColor_Hover As OLE_COLOR)
  1331.     m_XPColor_Hover = New_XPColor_Hover
  1332.     PropertyChanged "ColorHover"
  1333. End Property
  1334. Public Property Get DefaultColors() As Boolean
  1335.     DefaultColors = m_XPDefaultColors
  1336. End Property
  1337. Public Property Let DefaultColors(ByVal New_XPDefaultColors As Boolean)
  1338.     m_XPDefaultColors = New_XPDefaultColors
  1339.     PropertyChanged "DefaultColors"
  1340. End Property
  1341. Public Property Get BackColor() As OLE_COLOR
  1342.     BackColor = m_BackColor
  1343. End Property
  1344. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  1345.     m_BackColor = New_BackColor
  1346.     PropertyChanged "BackColor"
  1347.     UserControl.BackColor = m_BackColor
  1348.     Refresh
  1349. End Property
  1350. Public Property Get ForeColor() As OLE_COLOR
  1351.     ForeColor = m_ForeColor
  1352. End Property
  1353. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  1354.     m_ForeColor = New_ForeColor
  1355.     PropertyChanged "ForeColor"
  1356.     UserControl.ForeColor = m_ForeColor
  1357.     Refresh
  1358. End Property
  1359. Public Property Get DefCurHand() As Boolean
  1360.     DefCurHand = m_DefCurHand
  1361. End Property
  1362.  
  1363. Public Property Let DefCurHand(ByVal New_DefCurHand As Boolean)
  1364.     m_DefCurHand = New_DefCurHand
  1365.     PropertyChanged "DefCurHand"
  1366. End Property
  1367.  
  1368. Public Property Get ShowBorder() As Boolean
  1369.     ShowBorder = m_XPShowBorderAlways
  1370. End Property
  1371.  
  1372. Public Property Let ShowBorder(ByVal New_XPShowBorderAlways As Boolean)
  1373.     m_XPShowBorderAlways = New_XPShowBorderAlways
  1374.     PropertyChanged "ShowBorder"
  1375. End Property
  1376. Public Property Get MaskColor() As OLE_COLOR
  1377.     MaskColor = m_MaskColor
  1378. End Property
  1379.  
  1380. Public Property Let MaskColor(ByVal New_MaskColor As OLE_COLOR)
  1381.     m_MaskColor = New_MaskColor
  1382.     PropertyChanged "MaskColor"
  1383.     Refresh
  1384. End Property
  1385. Public Property Get Transparent() As Boolean
  1386.     Transparent = m_TransparentBG
  1387. End Property
  1388.  
  1389. Public Property Let Transparent(ByVal New_TransparentBG As Boolean)
  1390.     m_TransparentBG = New_TransparentBG
  1391.     PropertyChanged "Transparent"
  1392.     Refresh
  1393. End Property
  1394.  
  1395. Public Property Get BEVEL() As Integer
  1396.     BEVEL = m_BEVEL
  1397. End Property
  1398.  
  1399. Public Property Let BEVEL(ByVal New_BEVEL As Integer)
  1400.     m_BEVEL = New_BEVEL
  1401.     PropertyChanged "BEVEL"
  1402.     Refresh
  1403. End Property
  1404. Public Property Get BEVELDEPTH() As Integer
  1405.     BEVELDEPTH = m_BEVELDEPTH
  1406. End Property
  1407.  
  1408. Public Property Let BEVELDEPTH(ByVal New_BEVELDEPTH As Integer)
  1409.     m_BEVELDEPTH = New_BEVELDEPTH
  1410.     PropertyChanged "BEVELDEPTH"
  1411.     Refresh
  1412. End Property
  1413.  
  1414. Private Function COLOR_LongToRGB(UniColorValue As Long) As RGB
  1415.     Dim BlueS As Double, GreenS As Double, RGBs As String
  1416.     COLOR_LongToRGB.Blue = Fix((UniColorValue / 256) / 256)
  1417.     BlueS = (COLOR_LongToRGB.Blue * 256) * 256
  1418.     COLOR_LongToRGB.Green = Fix((UniColorValue - BlueS) / 256)
  1419.     GreenS = COLOR_LongToRGB.Green * 256
  1420.     COLOR_LongToRGB.Red = Fix(UniColorValue - BlueS - GreenS)
  1421.  
  1422. End Function
  1423. Private Function COLOR_UniColor(ColorVal As Long) As Long
  1424.  
  1425.     COLOR_UniColor = ColorVal
  1426.     If ColorVal > &HFFFFFF Or ColorVal < 0 Then COLOR_UniColor = GetSysColor(ColorVal And &HFFFFFF)
  1427. End Function
  1428. Private Function COLOR_DarkenLightenColor(ByVal Color As Long, ByVal Value As Long) As Long
  1429.     Dim R As Long, G As Long, b As Long
  1430.     b = ((Color \ &H10000) Mod &H100): b = b + ((b * Value) \ &HC0)
  1431.     G = ((Color \ &H100) Mod &H100) + Value
  1432.     R = (Color And &HFF) + Value
  1433.         If R < 0 Then R = 0
  1434.         If R > 255 Then R = 255
  1435.         If G < 0 Then G = 0
  1436.         If G > 255 Then G = 255
  1437.         If b < 0 Then b = 0
  1438.         If b > 255 Then b = 255
  1439.     COLOR_DarkenLightenColor = RGB(R, G, b)
  1440. End Function
  1441.  
  1442. Private Sub DrawLine(ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal Color As Long)
  1443.     Dim pt As POINTAPI
  1444.     Call DeleteObject(SelectObject(hdc, CreatePen(0, 1, Color)))
  1445.     MoveToEx hdc, X1, Y1, pt
  1446.     LineTo hdc, X2, Y2
  1447. End Sub
  1448.  
  1449. Private Sub DRAWRECT(DestHDC As Long, ByVal RectLEFT As Long, _
  1450.             ByVal RectTOP As Long, _
  1451.             ByVal RectRIGHT As Long, ByVal RectBOTTOM As Long, _
  1452.             ByVal MyColor As Long, _
  1453.             Optional FillRectWithColor As Byte = 0)
  1454.     Dim MyRect As RECT, Firca As Long
  1455.     Firca = CreateSolidBrush(COLOR_UniColor(MyColor))
  1456.     With MyRect
  1457.         .Left = RectLEFT
  1458.         .Top = RectTOP
  1459.         .Right = RectRIGHT
  1460.         .Bottom = RectBOTTOM
  1461.     End With
  1462.     If FillRectWithColor = 1 Then FillRect DestHDC, MyRect, Firca Else FrameRect DestHDC, MyRect, Firca
  1463.     DeleteObject Firca
  1464. End Sub
  1465.  
  1466. Private Sub DrawWinXPButton(ByVal None_Press_Disabled As Byte, Optional HOVERING As Byte)
  1467. Dim X As Long, Intg As Single, curBackColor As Long, OuterBorderColor As Long
  1468. Dim KolorHover As Long, KolorPressed As Long
  1469. DRAWRECT hdc, 0, 0, m_Stat, m_Tats, m_BackColor, 1
  1470. OuterBorderColor = &H80000015
  1471. If Enabled Then
  1472.     If m_XPDefaultColors = True Then
  1473.         KolorPressed = RGB(140, 170, 230)
  1474.         KolorHover = RGB(225, 153, 71)
  1475.     Else
  1476.         KolorPressed = m_XPColor_Pressed
  1477.         KolorHover = m_XPColor_Hover
  1478.     End If
  1479.  
  1480.     If None_Press_Disabled = 0 Then
  1481.              Intg = 25 / m_Tats: curBackColor = COLOR_DarkenLightenColor(COLOR_UniColor(m_BackColor), 48)
  1482.              For X = 1 To m_Tats
  1483.                  DrawLine 0, X, m_Stat, X, COLOR_DarkenLightenColor(curBackColor, -Intg * X)
  1484.              Next
  1485.            
  1486.              DRAWRECT hdc, 0, 0, m_Stat, m_Tats, OuterBorderColor
  1487.              SetPixel hdc, 1, 1, OuterBorderColor
  1488.              SetPixel hdc, 1, m_Tats - 2, OuterBorderColor
  1489.              SetPixel hdc, m_Stat - 2, 1, OuterBorderColor
  1490.              SetPixel hdc, m_Stat - 2, m_Tats - 2, OuterBorderColor
  1491.  
  1492.              If g_HasFocus = 1 Then
  1493.                  DRAWRECT hdc, 1, 2, m_Stat - 1, m_Tats - 2, KolorPressed
  1494.                  DrawLine 2, m_Tats - 2, m_Stat - 2, m_Tats - 2, COLOR_DarkenLightenColor(COLOR_UniColor(KolorPressed), -33)
  1495.                  DrawLine 2, 1, m_Stat - 2, 1, COLOR_DarkenLightenColor(COLOR_UniColor(KolorPressed), 65)
  1496.                  DrawLine 1, 2, m_Stat - 1, 2, COLOR_DarkenLightenColor(COLOR_UniColor(KolorPressed), 50)
  1497.                  DrawLine 2, 3, 2, m_Tats - 3, COLOR_DarkenLightenColor(COLOR_UniColor(KolorPressed), 31)
  1498.                  DrawLine m_Stat - 3, 3, m_Stat - 3, m_Tats - 3, COLOR_DarkenLightenColor(COLOR_UniColor(KolorPressed), 31)
  1499.              Else
  1500.                  DrawLine 2, m_Tats - 2, m_Stat - 2, m_Tats - 2, COLOR_DarkenLightenColor(curBackColor, -48)
  1501.                  DrawLine 1, m_Tats - 3, m_Stat - 2, m_Tats - 3, COLOR_DarkenLightenColor(curBackColor, -32)
  1502.                  DrawLine m_Stat - 2, 2, m_Stat - 2, m_Tats - 2, COLOR_DarkenLightenColor(curBackColor, -36)
  1503.                  DrawLine m_Stat - 3, 3, m_Stat - 3, m_Tats - 3, COLOR_DarkenLightenColor(curBackColor, -24)
  1504.                  DrawLine 2, 1, m_Stat - 2, 1, COLOR_DarkenLightenColor(curBackColor, 16)
  1505.                  DrawLine 1, 2, m_Stat - 2, 2, COLOR_DarkenLightenColor(curBackColor, 10)
  1506.                  DrawLine 1, 2, 1, m_Tats - 2, COLOR_DarkenLightenColor(curBackColor, -5)
  1507.                  DrawLine 2, 3, 2, m_Tats - 3, COLOR_DarkenLightenColor(curBackColor, -10)
  1508.              End If
  1509.              If HOVERING = 1 Then
  1510.                  DRAWRECT hdc, 1, 2, m_Stat - 1, m_Tats - 2, KolorHover
  1511.                  DrawLine 2, m_Tats - 2, m_Stat - 2, m_Tats - 2, COLOR_DarkenLightenColor(KolorHover, -40)
  1512.                  DrawLine 2, 1, m_Stat - 2, 1, COLOR_DarkenLightenColor(KolorHover, 90)
  1513.                  DrawLine 1, 2, m_Stat - 1, 2, COLOR_DarkenLightenColor(KolorHover, 35)
  1514.                  DrawLine 2, 3, 2, m_Tats - 3, COLOR_DarkenLightenColor(KolorHover, 20)
  1515.                  DrawLine m_Stat - 3, 3, m_Stat - 3, m_Tats - 3, COLOR_DarkenLightenColor(KolorHover, 20)
  1516.              End If
  1517.     ElseIf None_Press_Disabled = 2 Then
  1518.             Intg = 15 / m_Tats
  1519.             curBackColor = COLOR_DarkenLightenColor(COLOR_UniColor(m_BackColor), 48)
  1520.             curBackColor = COLOR_DarkenLightenColor(curBackColor, -32)
  1521.             For X = 1 To m_Tats
  1522.                 DrawLine 0, m_Tats - X, m_Stat, m_Tats - X, COLOR_DarkenLightenColor(curBackColor, -Intg * X)
  1523.             Next
  1524.             DRAWRECT hdc, 0, 0, m_Stat, m_Tats, OuterBorderColor
  1525.             SetPixel hdc, 1, 1, OuterBorderColor
  1526.             SetPixel hdc, 1, m_Tats - 2, OuterBorderColor
  1527.             SetPixel hdc, m_Stat - 2, 1, OuterBorderColor
  1528.             SetPixel hdc, m_Stat - 2, m_Tats - 2, OuterBorderColor
  1529.             
  1530.             DrawLine 2, m_Tats - 2, m_Stat - 2, m_Tats - 2, COLOR_DarkenLightenColor(curBackColor, 16)
  1531.             DrawLine 1, m_Tats - 3, m_Stat - 2, m_Tats - 3, COLOR_DarkenLightenColor(curBackColor, 10)
  1532.             DrawLine m_Stat - 2, 2, m_Stat - 2, m_Tats - 2, COLOR_DarkenLightenColor(curBackColor, 5)
  1533.             DrawLine m_Stat - 3, 3, m_Stat - 3, m_Tats - 3, curBackColor
  1534.             DrawLine 2, 1, m_Stat - 2, 1, COLOR_DarkenLightenColor(curBackColor, -32)
  1535.             DrawLine 1, 2, m_Stat - 2, 2, COLOR_DarkenLightenColor(curBackColor, -24)
  1536.             DrawLine 1, 2, 1, m_Tats - 2, COLOR_DarkenLightenColor(curBackColor, -32)
  1537.             DrawLine 2, 2, 2, m_Tats - 2, COLOR_DarkenLightenColor(curBackColor, -22)
  1538.     End If
  1539. Else
  1540.         curBackColor = COLOR_DarkenLightenColor(COLOR_UniColor(m_BackColor), 48)
  1541.         DRAWRECT hdc, 0, 0, m_Stat, m_Tats, COLOR_DarkenLightenColor(curBackColor, -24), 1
  1542.         DRAWRECT hdc, 0, 0, m_Stat, m_Tats, COLOR_DarkenLightenColor(curBackColor, -84)
  1543.         SetPixel hdc, 1, 1, COLOR_DarkenLightenColor(curBackColor, -72)
  1544.         SetPixel hdc, 1, m_Tats - 2, COLOR_DarkenLightenColor(curBackColor, -72)
  1545.         SetPixel hdc, m_Stat - 2, 1, COLOR_DarkenLightenColor(curBackColor, -72)
  1546.         SetPixel hdc, m_Stat - 2, m_Tats - 2, COLOR_DarkenLightenColor(curBackColor, -72)
  1547. End If
  1548. End Sub
  1549.  
  1550. Private Sub RoundCorners()
  1551. Dim Alan1 As Long, Alan2 As Long
  1552.     DeleteObject Origin
  1553.     Origin = CreateRectRgn(0, 0, m_Stat, m_Tats)
  1554.     Alan2 = CreateRectRgn(0, 0, 0, 0)
  1555.         Alan1 = CreateRectRgn(0, 0, 2, 1)
  1556.         CombineRgn Alan2, Origin, Alan1, 4
  1557.         DeleteObject Alan1
  1558.         Alan1 = CreateRectRgn(0, m_Tats, 2, m_Tats - 1)
  1559.         CombineRgn Origin, Alan2, Alan1, 4
  1560.         DeleteObject Alan1
  1561.         Alan1 = CreateRectRgn(m_Stat, 0, m_Stat - 2, 1)
  1562.         CombineRgn Alan2, Origin, Alan1, 4
  1563.         DeleteObject Alan1
  1564.         Alan1 = CreateRectRgn(m_Stat, m_Tats, m_Stat - 2, m_Tats - 1)
  1565.         CombineRgn Origin, Alan2, Alan1, 4
  1566.         DeleteObject Alan1
  1567.         Alan1 = CreateRectRgn(0, 1, 1, 2)
  1568.         CombineRgn Alan2, Origin, Alan1, 4
  1569.         DeleteObject Alan1
  1570.         Alan1 = CreateRectRgn(0, m_Tats - 1, 1, m_Tats - 2)
  1571.         CombineRgn Origin, Alan2, Alan1, 4
  1572.         DeleteObject Alan1
  1573.         Alan1 = CreateRectRgn(m_Stat, 1, m_Stat - 1, 2)
  1574.         CombineRgn Alan2, Origin, Alan1, 4
  1575.         DeleteObject Alan1
  1576.         Alan1 = CreateRectRgn(m_Stat, m_Tats - 1, m_Stat - 1, m_Tats - 2)
  1577.         CombineRgn Origin, Alan2, Alan1, 4
  1578.         DeleteObject Alan1
  1579. DeleteObject Alan2
  1580. SetWindowRgn hWnd, Origin, True
  1581. End Sub
  1582. Private Sub TransParentPic(DestDC As Long, _
  1583.                            DestDCTrans As Long, _
  1584.                            SrcDC As Long, _
  1585.                            SrcRectLeft As Long, SrcRectTop As Long, _
  1586.                            SrcRectRight As Long, SrcRectBottom As Long, _
  1587.                            DstX As Long, _
  1588.                            DstY As Long, _
  1589.                            MaskColor As Long)
  1590.    
  1591.   Dim nRet As Long, W As Integer, H As Integer
  1592.   Dim MonoMaskDC As Long, hMonoMask As Long
  1593.   Dim MonoInvDC As Long, hMonoInv As Long
  1594.   Dim ResultDstDC As Long, hResultDst As Long
  1595.   Dim ResultSrcDC As Long, hResultSrc As Long
  1596.   Dim hPrevMask As Long, hPrevInv As Long
  1597.   Dim hPrevSrc As Long, hPrevDst As Long
  1598.   Dim SrcRect As RECT
  1599.   
  1600.   With SrcRect
  1601.     .Left = SrcRectLeft
  1602.     .Top = SrcRectTop
  1603.     .Right = SrcRectRight
  1604.     .Bottom = SrcRectBottom
  1605.   End With
  1606.  
  1607.   W = SrcRectRight - SrcRectLeft
  1608.   H = SrcRectBottom - SrcRectTop
  1609.    
  1610.   MonoMaskDC = CreateCompatibleDC(DestDCTrans)
  1611.   MonoInvDC = CreateCompatibleDC(DestDCTrans)
  1612.   hMonoMask = CreateBitmap(W, H, 1, 1, ByVal 0&)
  1613.   hMonoInv = CreateBitmap(W, H, 1, 1, ByVal 0&)
  1614.   hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
  1615.   hPrevInv = SelectObject(MonoInvDC, hMonoInv)
  1616.    
  1617.   ResultDstDC = CreateCompatibleDC(DestDCTrans)
  1618.   ResultSrcDC = CreateCompatibleDC(DestDCTrans)
  1619.   hResultDst = CreateCompatibleBitmap(DestDCTrans, W, H)
  1620.   hResultSrc = CreateCompatibleBitmap(DestDCTrans, W, H)
  1621.   hPrevDst = SelectObject(ResultDstDC, hResultDst)
  1622.   hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
  1623.    
  1624.   Dim OldBC As Long
  1625.   OldBC = SetBkColor(SrcDC, MaskColor)
  1626.   nRet = BitBlt(MonoMaskDC, 0, 0, W, H, SrcDC, _
  1627.                 SrcRect.Left, SrcRect.Top, &HCC0020)
  1628.   MaskColor = SetBkColor(SrcDC, OldBC)
  1629.    
  1630.   nRet = BitBlt(MonoInvDC, 0, 0, W, H, _
  1631.                 MonoMaskDC, 0, 0, &H330008)
  1632.    
  1633.   nRet = BitBlt(ResultDstDC, 0, 0, W, H, _
  1634.                 DestDCTrans, DstX, DstY, &HCC0020)
  1635.    
  1636.   nRet = BitBlt(ResultDstDC, 0, 0, W, H, _
  1637.                 MonoMaskDC, 0, 0, &H8800C6)
  1638.    
  1639.  
  1640.   nRet = BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, _
  1641.                 SrcRect.Left, SrcRect.Top, &HCC0020)
  1642.    
  1643.   nRet = BitBlt(ResultSrcDC, 0, 0, W, H, _
  1644.                 MonoInvDC, 0, 0, &H8800C6)
  1645.    
  1646.   nRet = BitBlt(ResultDstDC, 0, 0, W, H, _
  1647.                 ResultSrcDC, 0, 0, &H660046)
  1648.    
  1649.   nRet = BitBlt(DestDC, DstX, DstY, W, H, _
  1650.                 ResultDstDC, 0, 0, &HCC0020)
  1651.                 
  1652.   hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
  1653.   DeleteObject hMonoMask
  1654.  
  1655.   hMonoInv = SelectObject(MonoInvDC, hPrevInv)
  1656.   DeleteObject hMonoInv
  1657.  
  1658.   hResultDst = SelectObject(ResultDstDC, hPrevDst)
  1659.   DeleteObject hResultDst
  1660.  
  1661.   hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
  1662.   DeleteObject hResultSrc
  1663.  
  1664.   DeleteDC MonoMaskDC
  1665.   DeleteDC MonoInvDC
  1666.   DeleteDC ResultDstDC
  1667.   DeleteDC ResultSrcDC
  1668. End Sub
  1669.  
  1670. Private Sub SetAccessKeys()
  1671. Dim ampersandPos As Long
  1672. If Len(m_Caption) > 1 Then
  1673.     ampersandPos = InStr(1, m_Caption, "&", vbTextCompare)
  1674.     If (ampersandPos < Len(m_Caption)) And (ampersandPos > 0) Then
  1675.         If Mid(m_Caption, ampersandPos + 1, 1) <> "&" Then
  1676.             UserControl.AccessKeys = LCase(Mid(m_Caption, ampersandPos + 1, 1))
  1677.         Else
  1678.             ampersandPos = InStr(ampersandPos + 2, m_Caption, "&", vbTextCompare)
  1679.             If Mid(m_Caption, ampersandPos + 1, 1) <> "&" Then
  1680.                 UserControl.AccessKeys = LCase(Mid(m_Caption, ampersandPos + 1, 1))
  1681.             Else
  1682.                 UserControl.AccessKeys = ""
  1683.             End If
  1684.         End If
  1685.     Else
  1686.         UserControl.AccessKeys = ""
  1687.     End If
  1688. Else
  1689.     UserControl.AccessKeys = ""
  1690. End If
  1691. End Sub
  1692.  
  1693. Private Sub ShowToolTipText()
  1694. Dim m_m As Long
  1695. On Error GoTo Error
  1696. If m_Counter <= 0 Then Exit Sub
  1697. For m_m = 1 To m_Counter
  1698.     ShowToolTipsBalloon m_ControlType(m_m).cntrlObjectForm, m_ControlType(m_m).cntrlHwnd, m_ControlType(m_m).cntrlToolTipsText, m_ControlType(m_m).cntrlToolTipsTitle, m_ControlType(m_m).cntrlToolTipsIcon
  1699. Next m_m
  1700. Error:
  1701. End Sub
  1702.  
  1703. Private Function AddToolTipText(Optional ObjectFormOwner As Object = Nothing, Optional AddObjectToShowToolTips As Long, Optional ToolTipText As String _
  1704. = "", Optional ToolTipTitle As String = "", Optional _
  1705. ToolTipIcon As ttIconType = 1)
  1706. On Error GoTo Error
  1707. m_Counter = m_Counter + 1
  1708. ReDim Preserve m_ControlType(m_Counter)
  1709. Set m_ControlType(m_Counter).cntrlObjectForm = ObjectFormOwner
  1710. m_ControlType(m_Counter).cntrlHwnd = AddObjectToShowToolTips
  1711. m_ControlType(m_Counter).cntrlToolTipsText = ToolTipText
  1712. m_ControlType(m_Counter).cntrlToolTipsTitle = ToolTipTitle
  1713. m_ControlType(m_Counter).cntrlToolTipsIcon = ToolTipIcon
  1714. Error:
  1715. End Function
  1716.  
  1717. Private Sub ShowToolTipsBalloon(Optional ObjectForm As Object, Optional OwnHwnd As Long, Optional _
  1718. ToolTipsText As String, Optional ToolTipTitle As String, Optional _
  1719. ToolTipIcon As Integer)
  1720.     Dim tiInfo As TOOLINFO
  1721.     Dim MyHwnD As Long
  1722.     Dim hWndTip As Long, dwFlags As Long, ICEx As ICCEX
  1723.     On Error GoTo Error
  1724.     dwFlags = TTS_NOPREFIX Or TTS_ALWAYSTIP Or TTS_BALLOON
  1725.     
  1726.     With ICEx
  1727.         .dwSize = Len(ICEx)
  1728.         .dwICC = ICC_WIN95_CLASSES
  1729.     End With
  1730.     
  1731.     InitCommonControlsEx ICEx
  1732.     
  1733.     hWndTip = CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASSA, "", WS_POPUP Or dwFlags, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, OwnHwnd, 0, App.hInstance, ByVal 0&)
  1734.     
  1735.     If hWndTip = 0 Then Exit Sub
  1736.     
  1737.     SetWindowPos hWndTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
  1738.     
  1739.     ghWndTip = hWndTip
  1740.     ghWndParent = ObjectForm.hWnd
  1741.     
  1742.     With tiInfo
  1743.         .dwFlags = TTF_SUBCLASS Or TTF_TRANSPARENT
  1744.         .hWnd = OwnHwnd
  1745.         .lpszText = StrPtr(StrConv(ToolTipsText, vbFromUnicode))
  1746.         .hInst = App.hInstance
  1747.         GetClientRect OwnHwnd, .rtRect
  1748.         
  1749.         .cbSize = Len(tiInfo)
  1750.  
  1751.     End With
  1752.     
  1753.     SendMessage ghWndTip, TTM_ADDTOOL, 0&, tiInfo
  1754.     If ToolTipTitle <> vbNullString Or ToolTipIcon <> 0 Then
  1755.         SendMessage ghWndTip, TTM_SETTITLE, CLng(ToolTipIcon), ByVal ToolTipTitle
  1756.     End If
  1757. Error:
  1758. End Sub
  1759.  
  1760.